#
# Copyright (c) 2014 Luciano Xumerle. All rights reserved.
#
# This file is part of gephinfo.
#
# gephinfo is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

package genoHASH;

require 5.003;
use warnings;
use strict;
use utf8;

=head2 new()

Create the empty genoHASH object.

 hash structure
 ^^^^^^^^^^^^^^
 hash{--IDPOS--} -> id position in header array
 hash{--HEADER--} -> the header array
 hash{--ORDINE--} -> the list of id elements with file order
 hash{id_num}->{attribute}->value

=cut

sub new
{
    my $class = shift;

    my $self = {
        '--HEADER--' => [],
        '--ORDINE--' => []
    };

    bless( $self, $class );
    return ($self);
}

=head2 csv2hash( $file_csv, $separator,  $id_column_name )

Load a csv file to the hash.

=cut

sub cvs2hash
{
    my $self       = shift;
    my $csv        = shift;
    my $separatore = shift;
    my $id_name    = shift;

    # check separator and id column values
    $separatore = ';'  if ( !defined $separatore );
    $id_name    = 'id' if ( !defined $id_name );

    open( CSVFILE, $csv ) || die "\nERROR: No file $csv!!!\n\n";

    # prepare header
    my $tt = <CSVFILE>;
    chomp $tt;
    my @row = split $separatore, $tt . $separatore . 'null';
    pop @row;

    # finding id position on header list
    $tt = 0;
    my $id = -1;
    foreach my $att (@row)
    {
        if ( $att eq $id_name )
        {
            $id = $tt;
            last;
        }
        $tt++;
    }
    my @header = @row;
    die "\nERROR: Missing ID attribute!!!\n\n" if ( $id == -1 );
    foreach my $att (@header)
    {
        next if ( grep $_ eq $att, @{ $self->{'--HEADER--'} } );
        push @{ $self->{'--HEADER--'} }, $att;
    }
    $self->{'--IDPOS--'} = $id if ( !defined $self->{'--IDPOS--'} );

    # parse data on CSV file
    while ( my $row = <CSVFILE> )
    {
        chomp $row;
        my @row = split $separatore, $row . $separatore . 'null';
        pop @row;

        # add id to id list if id is not present
        push @{ $self->{'--ORDINE--'} }, $row[$id]
          if ( !grep $_ eq $row[$id], @{ $self->{'--ORDINE--'} } );

        # update values in hash
        for ( my $i = 0 ; $i <= $#row ; $i++ )
        {
            $self->{ $row[$id] }->{ $header[$i] } = $row[$i];
        }
    }
    close CSVFILE;
}

=head2 existsAttribute( $attribute )

Check if there are values for $attribute.

=cut

sub existsAttribute
{
    my $self = shift;
    my $att  = shift;
    return 1 if ( grep $_ eq $att, @{ $self->{'--HEADER--'} } );
    return 0;
}

=head2 getIDlist()

Returns the list stored in $self->{'--ORDINE--'}

=cut

sub getIDlist
{
    my $self = shift;
    return $self->{'--ORDINE--'};
}

=head2 getAttributeList()

Returns the list stored in $self->{'--HEADER--'}

=cut

sub getAttributeList
{
    my $self = shift;
    return $self->{'--HEADER--'};
}

=head2 existsID( $attribute )

Check if there are values for $attribute.

=cut

sub existsID
{
    my $self = shift;
    my $id   = shift;
    return 1 if ( grep $_ eq $id, @{ $self->{'--ORDINE--'} } );
    return 0;
}

=head2 vcf2hash( $filevcf, $no_homoref )

Load a VCF file to the hash.
If $no_homoref == 1 then the omoref positions (GT equals to 0/0)
will be skipped.

=cut

sub vcf2hash
{
    my $self       = shift;
    my $file       = shift;
    my $no_homoref = shift;
    $no_homoref = 0 if ( !defined $no_homoref || $no_homoref ne '1' );

    my @id1 = ();

    open( FILEHASH, $file ) || die;
    while (<FILEHASH>)
    {
        chomp;
        if (m/^#CHROM/)
        {
            my @a     = split /\t/;
            my $idnum = 0;
            foreach my $id ( @a[ 9 .. $#a ] )
            {
                $idnum++;
                push @{ $self->{'--ORDINE--'} }, $id
                  if ( !grep $_ eq $id, @{ $self->{'--ORDINE--'} } );
            }
            push @{ $self->{'--HEADER--'} }, 'id';
            print STDERR qq|Found $idnum IDs in $file\n|;
        }
        elsif (m/^#/)
        {
            next;
        }
        else
        {
            my @a       = split /\t/;
            my $count   = 0;
            my $chrom   = $a[0];
            my $pos     = $a[1];
            my @alleles = split ',', $a[3] . ',' . $a[4];
            my @geno    = ( '.', '.' );
            foreach my $geno ( @a[ 9 .. $#a ] )
            {
                my $id = $self->{'--ORDINE--'}->[$count];
                if ( $geno =~ m/^(\d+)[\|\/](\d+):/ )
                {
                    my $gt1 = $1;
                    my $gt2 = $2;
                    next if ( $no_homoref == 0 && $gt2 == 0 && $gt1 == $gt2 );
                    my $att = $chrom . ':' . $pos;
                    @geno = sort ( $alleles[$gt1], $alleles[$gt2] );
                    $self->{$id}->{$att} = join '/', @geno;
                    push @{ $self->{'--HEADER--'} }, $att
                      if ( !grep $_ eq $att, @{ $self->{'--HEADER--'} } );
                }
                $count++;
            }
        }
    }
    close FILEHASH;
}

=head2 hash2csv( $separator, $null_value )

Print to STDIN the CSV file stored in hash created by F<csv2hash>

=cut

sub hash2csv
{
    my $hash       = shift;
    my $separatore = shift;
    my $nullo      = shift;

    print join( $separatore, @{ $hash->{'--HEADER--'} } ), "\n";

    foreach my $id ( @{ $hash->{'--ORDINE--'} } )
    {
        next if ( !defined $hash->{$id} );
        my @row = ();
        foreach my $att ( @{ $hash->{'--HEADER--'} } )
        {
            my $val = $nullo;
            $val = $hash->{$id}->{$att} if ( defined $hash->{$id}->{$att} );
            push @row, $val;
        }
        print join( $separatore, @row ), "\n";
    }
}

=head2 compareHASH( $hash2, $null_value )

Compare two CSV files imported by F<csv2hash>

=cut

sub compareHASH
{
    my $self  = shift;
    my $h2    = shift;
    my $nullo = shift;
    $nullo = 'NULL' if ( !defined $nullo );

    #
    # ID CHECK
    #
    foreach my $id ( @{ $self->{'--ORDINE--'} } )
    {
        if ( !exists $h2->{$id} )
        {
            print qq|ID_ONLY_FILE_1\t$id\n|;
        }
    }
    foreach my $id ( @{ $h2->{'--ORDINE--'} } )
    {
        if ( !exists $self->{$id} )
        {
            print qq|ID_ONLY_FILE_2\t$id\n|;
        }
    }

    my @commonheader = ();
    #
    # HEADER
    #
    foreach my $att ( @{ $self->{'--HEADER--'} } )
    {
        my $OK = 0;
        if ( grep $_ eq $att, @{ $h2->{'--HEADER--'} } )
        {
            $OK++;
            push @commonheader, $att;
        }
        print qq|ATTRIBUTE_ONLY_FILE_1\t$att\n| if ( $OK == 0 );
    }
    foreach my $att ( @{ $h2->{'--HEADER--'} } )
    {
        my $OK = 0;
        $OK++ if ( grep $_ eq $att, @{ $self->{'--HEADER--'} } );
        print qq|ATTRIBUTE_ONLY_FILE_2\t$att\n| if ( $OK == 0 );
    }

    #
    # CHECK ELEMENTS
    #
    print qq|type\tid\tattribute\t$ARGV[0]\t$ARGV[1]\n|;
    foreach my $id ( @{ $self->{'--ORDINE--'} } )
    {
        next if ( !defined $self->{$id} );
        my @row = ();
        foreach my $att (@commonheader)
        {
            my $va1 = $nullo;
            my $va2 = $nullo;
            $va1 = $self->{$id}->{$att} if ( defined $self->{$id}->{$att} );
            $va2 = $h2->{$id}->{$att}   if ( defined $h2->{$id}->{$att} );
            if ( $va1 ne $va2 )
            {
                print qq|DIFFERENCES\t$id\t$att\t$va1\t$va2\n|;
            }
        }
    }
}

=head2 getUnrelatedID()

Returns a pointer to the list of the founder subjects
stored into the hash.
The attributes "fam", "sbj", "fth", "mth" have to be
correctly defined to get the list.

=cut

sub getUnrelatedID
{
    my $self   = shift;
    my $select = [];
    foreach my $id ( @{ $self->{'--ORDINE--'} } )
    {
        my $fth = '';
        $fth = $self->{$id}->{'fth'} if ( defined $self->{$id}->{'fth'} );
        $fth = '' if ( $fth =~ m/^[\s0xX]*$/ );

        my $mth = '';
        $mth = $self->{$id}->{'mth'} if ( defined $self->{$id}->{'mth'} );
        $mth = '' if ( $mth =~ m/^[\s0xX]*$/ );

        ## fth and mth fields are equal only when value is '' -> unrelated
        push @$select, $id if ( $mth eq $fth );
    }
    return $select;
}

=head1 AUTHOR

Luciano Xumerle (luciano.xumerle@gmail.com)
